home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / tq.el.z / tq.el
Encoding:
Text File  |  1998-05-21  |  4.1 KB  |  122 lines

  1. ;;; tq.el --- utility to maintain a transaction queue
  2.  
  3. ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Scott Draves <spot@cs.cmu.edu>
  6. ;; Adapted-By: ESR
  7. ;; Keywords: extensions
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24. ;; 02111-1307, USA.
  25.  
  26. ;;; Synched up with: FSF 19.34.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;;; manages receiving a stream asynchronously, 
  31. ;;; parsing it into transactions, and then calling
  32. ;;; handler functions
  33.  
  34. ;;; Our basic structure is the queue/process/buffer triple.  Each entry
  35. ;;; of the queue is a regexp/closure/function triple.  We buffer
  36. ;;; bytes from the process until we see the regexp at the head of the
  37. ;;; queue.  Then we call the function with the closure and the
  38. ;;; collected bytes.
  39.  
  40. ;;; Code:
  41.  
  42. ;;;###autoload
  43. (defun tq-create (process)
  44.   "Create and return a transaction queue communicating with PROCESS.
  45. PROCESS should be a subprocess capable of sending and receiving
  46. streams of bytes.  It may be a local process, or it may be connected
  47. to a tcp server on another machine."
  48.   (let ((tq (cons nil (cons process
  49.                 (generate-new-buffer
  50.                  (concat " tq-temp-"
  51.                      (process-name process)))))))
  52.     (set-process-filter process
  53.             (`(lambda (proc string)
  54.                (tq-filter  '(, tq) string))))
  55.     tq))
  56.  
  57. ;;; accessors
  58. (defun tq-queue   (tq) (car tq))
  59. (defun tq-process (tq) (car (cdr tq)))
  60. (defun tq-buffer  (tq) (cdr (cdr tq)))
  61.  
  62. (defun tq-queue-add (tq re closure fn)
  63.   (setcar tq (nconc (tq-queue tq)
  64.             (cons (cons re (cons closure fn)) nil)))
  65.   'ok)
  66.  
  67. (defun tq-queue-head-regexp  (tq) (car (car (tq-queue tq))))
  68. (defun tq-queue-head-fn      (tq) (cdr (cdr (car (tq-queue tq)))))
  69. (defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
  70. (defun tq-queue-empty        (tq) (not (tq-queue tq)))
  71. (defun tq-queue-pop          (tq) (setcar tq (cdr (car tq))) (null (car tq)))
  72.  
  73.  
  74. ;;; must add to queue before sending!
  75. (defun tq-enqueue (tq question regexp closure fn)
  76.   "Add a transaction to transaction queue TQ.
  77. This sends the string QUESTION to the process that TQ communicates with.
  78. When the corresponding answer comes back, we call FN
  79. with two arguments: CLOSURE, and the answer to the question.
  80. REGEXP is a regular expression to match the entire answer;
  81. that's how we tell where the answer ends."
  82.   (tq-queue-add tq regexp closure fn)
  83.   (process-send-string (tq-process tq) question))
  84.  
  85. (defun tq-close (tq)
  86.   "Shut down transaction queue TQ, terminating the process."
  87.   (delete-process (tq-process tq))
  88.   (kill-buffer (tq-buffer tq)))
  89.  
  90. (defun tq-filter (tq string)
  91.   "Append STRING to the TQ's buffer; then process the new data."
  92.   (set-buffer (tq-buffer tq))
  93.   (goto-char (point-max))
  94.   (insert string)
  95.   (tq-process-buffer tq))
  96.  
  97. (defun tq-process-buffer (tq)
  98.   "Check TQ's buffer for the regexp at the head of the queue."
  99.   (set-buffer (tq-buffer tq))
  100.   (if (= 0 (buffer-size)) ()
  101.     (if (tq-queue-empty tq)
  102.     (let ((buf (generate-new-buffer "*spurious*")))
  103.       (copy-to-buffer buf (point-min) (point-max))
  104.       (delete-region (point-min) (point))
  105.       (pop-to-buffer buf nil)
  106.       (error "Spurious communication from process %s, see buffer %s"
  107.          (process-name (tq-process tq))
  108.          (buffer-name buf)))
  109.       (goto-char (point-min))
  110.       (if (re-search-forward (tq-queue-head-regexp tq) nil t)
  111.       (let ((answer (buffer-substring (point-min) (point))))
  112.         (delete-region (point-min) (point))
  113.         (funcall (tq-queue-head-fn tq)
  114.              (tq-queue-head-closure tq)
  115.              answer)
  116.         (tq-queue-pop tq)
  117.         (tq-process-buffer tq))))))
  118.  
  119. (provide 'tq)
  120.  
  121. ;;; tq.el ends here
  122.